home *** CD-ROM | disk | FTP | other *** search
/ Directorty Opus 5 - Magellan 2 / Opus 5 - Magellan 2.iso / Extras / LhALZXDirDOps5 / LZXDir.dopus5 < prev   
Text File  |  1995-11-25  |  21KB  |  713 lines
  1. /*
  2.   $VER: LZXDir.dopus5 1.1 tINIC/mAXIMUM (26.6.95) - This version by Stone-D
  3.  
  4.   Copyright © 1995 by Edmund Vermeulen
  5.   This version by Stone-D  (Laga Hale)
  6.   Modified to co-exist with lha version of same file also modified by Stone-D.
  7.   Placed in the public domain. No restrictions on distribution or usage.
  8.  
  9.   Usage differences with original :
  10.    The original required you to change the lister buttons to link to the
  11.    actual arexx script.  Not so with this one. Change, for example,
  12.    the COPY button from  AREXX DOpus5:Rexx/LzxDir.dopus5 {Qp}
  13.    back to the COMMAND COPY.  Do the same with MOVE, and DELETE.
  14.  
  15.   EMail Stone-D at the following address :
  16.  
  17.            stone-d@eldar.demon.co.uk
  18.  
  19.   To make LzxDir.dopus5 open it's own listview, refer to line 165
  20.  
  21.   ARexx script for Directory Opus 5 to show the contents of an Lzx archive
  22.   in an Opus lister and operate on the files and directories inside the
  23.   archive as if it is a normal directory, whilst allowing simultaneous access
  24.   to similiar scripts...such as the lzxdir.dopus5 one.
  25. */
  26.  
  27. ver='$VER: LZXDir.dopus5 1.1 tINIC/mAXIMUM (26.6.95) - This version by Stone-D'  /* for compiled version */
  28.  
  29. signal on syntax        /* intercept syntax errors */
  30. options results         /* need results */
  31. options failat 21       /* external commands are allowed return code 20 */
  32. numeric digits 10       /* needed for convertdate routine */
  33. lf='0a'x                /* ascii code for linefeed */
  34.  
  35. if ~show('l','rexxsupport.library') then
  36.    call addlib('rexxsupport.library',0,-30)  /* needed for delay() */
  37.  
  38. /* init locale */
  39. ok=show(l,'locale.library')
  40. if ~ok then
  41.    ok=addlib('locale.library',0,-30)
  42. if ok then
  43.    catalog=opencatalog('LZXDir.catalog','english',0)
  44.  
  45. parse arg cmd portname handle . '"' dblclck '"' .
  46. upper cmd
  47. if portname~='' then
  48.    address value portname
  49. else
  50.    portname=address()
  51. parse var portname '.' portno  /* port number */
  52.  
  53. if handle='' then do
  54.    lister query source
  55.    if rc>0 then
  56.       call quitit
  57.    parse var result handle .  /* only need first source */
  58.    end
  59.  
  60. lister query handle numselentries
  61. entries=result
  62.  
  63. if dblclck~=='' then do
  64.    entries=1
  65.    if right(dblclck,1)='/' then do
  66.       filetype=1
  67.       selentry=left(dblclck,length(dblclck)-1)
  68.       end
  69.    else do
  70.       filetype=-1
  71.       selentry=dblclck
  72.       end
  73.    end
  74. else
  75.    if entries>0 then
  76.       call getfirstone
  77.  
  78. call checkLZXdir(handle)
  79.  
  80. topline=''
  81. listLZX=0
  82. notmove=cmd~='MOVE'
  83.  
  84. select
  85.    when cmd='GETDIR' then
  86.       call dogetdir
  87.    when cmd='BROWSE' then
  88.       call dogetdir
  89.    when cmd='GETSIZES' then
  90.       call dogetsizes
  91.    when cmd='DELETE' then
  92.       call dodelete
  93.    when cmd='COPY' then
  94.       call docopy
  95.    when cmd='MOVE' then
  96.       call docopy
  97.    when cmd='MAKEDIR' then
  98.       call domakedir
  99.    otherwise
  100.       if LZXdir then do
  101.          lister select handle '"'selentry'"' off
  102.          lister refresh handle
  103.          address command 'LZX -m x "'||patch(LZXfile,0)||'" "'||patch(LZXsubdir||selentry,1)||'" T:'
  104.          if rc>0 then
  105.             call quitit(getcatstr(11,'Error while extracting from archive.'))
  106.          thisfile='"T:'patch(LZXsubdir||selentry,1)'"'
  107.          command cmd thisfile
  108.          lister wait handle
  109.          do until rc~=20  /* keep trying until not in use */
  110.             call delay(200)
  111.             address command 'Delete >NIL:' thisfile 'QUIET FORCE ALL'
  112.             end
  113.          end
  114.       else
  115.          command cmd
  116.    end
  117.  
  118. call quitit(topline)  /* finished */
  119.  
  120.  
  121. dogetdir:
  122.  
  123.    if ~show('p','LZXDir-handler'portno) then
  124.       address command 'Run >NIL: <NIL: rx DOpus5:arexx/LZXDir-handler' portname
  125.    oldLZXdir=LZXdir
  126.    if entries>0 then
  127.       if filetype>0 then  /* list a new dir */
  128.          if LZXdir then
  129.             LZXsubdir=LZXsubdir||selentry'/'
  130.          else
  131.             winpath=winpath||selentry'/'
  132.       else do  /* list an archive file */
  133.          if pos('|'upper(right(selentry,4)'|'),'|.LZX|')=0 then
  134.             call quitit(getcatstr(18,'Sorry, LZXDir.dopus5 can only'lf'list LZX archives.'))
  135.          if LZXdir then do
  136.             lister query dest
  137.             if rc>0 then
  138.                call quitit(getcatstr(9,'No destination selected!'))
  139.             parse var result desthandle .
  140.             lister query desthandle path
  141.             destpath=result
  142.             dopus request '"'getcatstr(20,'This is an archive in an archive.'lf||lf'Extract it to'lf"'%s'"lf'and then list it?',destpath)'"' getcatstr(21,'Extract|Cancel')
  143.             if ~rc then
  144.                call quitit
  145.             address command 'LZX e -m -a "'patch(LZXfile,0)'" "'destpath'" "'patch(LZXsubdir||selentry,1)'"'
  146.             if rc>0 then
  147.                call quitit(getcatstr(11,'Error while extracting from archive.'))
  148.             lister read desthandle '"'destpath'"' force
  149.             LZXfile=destpath||selentry
  150.             end
  151.          else
  152.             LZXfile=winpath||selentry
  153.  
  154.          LZXdir=1
  155.          LZXsubdir=''
  156.          listLZX=1
  157.          end
  158.  
  159.    lister select handle '"'selentry'"' off
  160.    lister refresh handle
  161.  
  162.    if LZXdir then do
  163.       if cmd='BROWSE' then do
  164.          oldhandle=handle
  165. /* The following makes lzxdir open it's own lister window. Uncomment to make it true  */
  166. /*         lister new */
  167. /*         handle=result */
  168.          lister set handle title getcatstr(0,'LZXDir listed archive')
  169.          lister set handle source
  170.          address command 'Copy >NIL: T:LZXDir.list'oldhandle 'T:LZXDir.list'handle
  171.          end
  172.       else do
  173.          if ~oldLZXdir then
  174.             lister empty handle  /* use a new cache */
  175.          lister set handle title getcatstr(0,'LZXDir listed archive')
  176.          end
  177.       call showLZXdir
  178.       end
  179.    else
  180.       if cmd='BROWSE' then
  181.          command scandir new winpath
  182.       else do
  183.          if entries=0 then
  184.             winpath=''
  185.          command scandir winpath
  186.          end
  187.    return
  188.  
  189.  
  190. dodelete:
  191.  
  192.    askdelete=1
  193.    if LZXdir then do
  194.       if entries=0 then
  195.          call quitit
  196.       if notmove then do
  197.          lister set handle busy on
  198.          if askdelete then do
  199.             lister query handle numselfiles
  200.             nfiles=result
  201.             lister query handle numseldirs
  202.             ndirs=result
  203.             dopus request '"'getcatstr(5,'Warning: you cannot get back'lf'what you delete! OK to delete:'lf||lf'%s file(s) and'lf'%s drawer(s) (and their contents)?',nfiles,ndirs)'"' getcatstr(6,'Proceed|Cancel')
  204.             if ~rc then
  205.                call quitit
  206.             end
  207.          call getall
  208.          end
  209.       actionfile_1=""
  210.       call open('actionfile','T:actionfile'handle,'w')
  211.       do i=1 to entries
  212.          if type.i>0 then
  213.             wild='/#?'
  214.          else
  215.             wild=''
  216.          call writeln('actionfile','"'patch(LZXsubdir||name.i,1)||wild'"')
  217.          actionfile_1=actionfile_1||'"'patch(LZXsubdir||name.i,1)||wild'" '
  218.          lister remove handle '"'name.i'"'
  219.          end
  220.       call close('actionfile')
  221.       lister set handle progress '-1' getcatstr(7,'Deleting from archive...')
  222.       address command 'LZX d -m "'patch(LZXfile,0)'" 'actionfile_1
  223.       if rc>0 then do
  224.          topline=getcatstr(8,'Error while deleting from archive.')
  225.          listLZX=1
  226.          call showLZXdir
  227.          end
  228.       else
  229.          lister refresh handle
  230.       address command 'Delete >NIL: T:actionfile'handle 'QUIET'
  231.       address command 'Delete >NIL: T:LZXDir.list'handle 'QUIET'  /* archive has changed */
  232.       lister set handle busy off
  233.       end
  234.    else do
  235.       command delete
  236.       lister wait handle
  237.       end
  238.    return
  239.  
  240.  
  241. docopy:
  242.  
  243.    if entries=0 then
  244.       call quitit
  245.    problem=0
  246.    src=winpath
  247.    s_LZXdir=LZXdir
  248.    s_LZXfile=LZXfile
  249.    s_LZXsubdir=LZXsubdir
  250.    lister query dest
  251.    if rc>0&LZXdir then
  252.       call quitit(getcatstr(9,'No destination selected!'))
  253.    parse var result desthandle .  /* only need first destination */
  254.    call checkLZXdir(desthandle)
  255.  
  256.    if s_LZXdir then do
  257.       lister set handle busy on
  258.       lister set desthandle busy on
  259.       if LZXdir then
  260.          winpath='T:LZXDir'handle'/'LZXsubdir
  261.       call getall
  262.       call LZXextract
  263.       if LZXdir then do
  264.          src=winpath
  265.          call LZXadd
  266.          end
  267.       else
  268.          if problem then do
  269.             lister set desthandle busy off
  270.             lister read desthandle '"'destpath'"' force
  271.             end
  272.          else do
  273.             do i=1 to entries
  274.                lister query handle entry '"'name.i'"' stem fileinfo.
  275.                if fileinfo.type>0 then
  276.                   fileinfo.size=0
  277.                lister add desthandle '"'name.i'"' fileinfo.size fileinfo.type fileinfo.date fileinfo.protstring fileinfo.comment
  278.                end
  279.             lister refresh desthandle
  280.             end
  281.       end
  282.    else
  283.       if LZXdir then do
  284.          lister set handle busy on
  285.          if ~notmove then do
  286.             cuthere=lastpos('/',LZXfile)
  287.             if cuthere=0 then
  288.                cuthere=pos(':',LZXfile)
  289.             name=substr(LZXfile,cuthere+1)
  290.             if left(LZXfile,length(src))==src then do
  291.                name=substr(LZXfile,length(src)+1)
  292.                parse var name name '/'
  293.                lister query handle entry '"'name'"' stem fileinfo.
  294.                if fileinfo.selected then
  295.                   call quitit(getcatstr(19,'You can''t move an archive into itself!'))
  296.                end
  297.             end
  298.          lister set desthandle busy on
  299.          call getall
  300.          call LZXadd
  301.          end
  302.       else do /* normal copy or move */
  303.          if notmove then
  304.             command copy
  305.          else
  306.             command move
  307.          lister wait handle
  308.          end
  309.  
  310.    lister set handle busy off
  311.    lister set desthandle busy off
  312.    if (s_LZXdir|LZXdir)&~notmove&~problem then do
  313.       LZXdir=s_LZXdir
  314.       LZXfile=s_LZXfile
  315.       LZXsubdir=s_LZXsubdir
  316.       lister query handle abort
  317.       if result then
  318.          call quitit(getcatstr(3,'Aborted...'))
  319.       lister set handle busy off
  320.       lister wait handle
  321.       call dodelete
  322.       end
  323.    return
  324.  
  325.  
  326. dogetsizes:
  327.  
  328.    if LZXdir then do
  329.       lister set handle busy on
  330.       lister set handle progress '-1' getcatstr(14,'Scanning directories...')
  331.       lister query handle numseldirs
  332.       ndirs=result
  333.       lister query handle seldirs stem dname.
  334.       n=1
  335.       do i=0 to dname.count-1
  336.          dirname.n=dname.i
  337.          lister query handle entry '"'dirname.n'"' stem fileinfo.
  338.          if fileinfo.size=0 then
  339.             n=n+1
  340.          end
  341.       dirsize.=0
  342.       dirsecs.=0
  343.       ndirs=n-1
  344.       call readlist(0)
  345.       lister set handle busy off
  346.       end
  347.    else
  348.       command getsizes
  349.    return
  350.  
  351.  
  352. domakedir:
  353.  
  354.    lister set handle busy on
  355.    dopus request '"MAKEDIR not supported yet for LZXDir V1.1!'lf'Simply make an Directory (f.ex. in T:)'lf'and copy it into the LZX file..."' '"_fUCK yA!!!"'
  356. /*   dopus getstring '"'getcatstr(15,'Enter directory name or archive name.lzx')'" 31 ""' getcatstr(16,'OK|Cancel')
  357.    dirtomake=result
  358.    if dirtomake==''|dirtomake='RESULT' then
  359.       call quitit
  360.    now=date('i')*86400+time('s')
  361.    if LZXdir then do  /* create empty dir in archive */
  362.       call createdirs(dirtomake'/')
  363.       address command 'cd T:LZXDir'handle'/'
  364.       address command 'LZX a -m -e -r "'patch(LZXfile,0)'" T:LZXDir'handle'/ T:LZXDir'handle'/#?'
  365.       if rc>0 then
  366.          topline=getcatstr(13,'Error while adding to archive.')
  367.       else do
  368.          lister add handle '"'dirtomake'" -1 1' now '----rwed'
  369.          lister refresh handle
  370.          end
  371.       address command 'Delete >NIL: T:LZXDir'handle 'ALL QUIET'
  372.       address command 'Delete >NIL: T:LZXDir.list'handle 'QUIET'
  373.       end
  374.    else
  375.       if upper(right(dirtomake,4))=='.LZX' then  /* create new archive */
  376.          if open('emptyarchive',winpath||dirtomake,'w') then do
  377.             call writech('emptyarchive','0'x)
  378.             call close('emptyarchive')
  379.             command protect 'NAME "'winpath||dirtomake'" CLEAR e'
  380.             lister add handle '"'dirtomake'" 1 -1' now '----rw-d'
  381.             lister refresh handle
  382.             end
  383.          else
  384.             topline=getcatstr(17,'Error creating archive.')
  385.       else do /* normal makedir */
  386.          lister set handle busy off
  387.          command makedir 'NOICON NAME "'dirtomake'"'
  388.          end */
  389.     return
  390.  
  391.  
  392. showLZXdir:
  393.  
  394.    lister clear handle
  395.    lister set handle busy on
  396.    lister set handle progress '-1' getcatstr(1,'Listing archive...')
  397.    lister set handle handler 'LZXDir-handler'portno
  398.    lister set handle path LZXfile'/'LZXsubdir
  399.    lister refresh handle full
  400.    now=date('i')*86400+time('s')
  401.    ndirs=0
  402.    call readlist(1)
  403.    return
  404.  
  405.  
  406. readlist:
  407.  
  408.    arg show  /* showdir or getsizes? */
  409.    if ~exists(LZXfile) then
  410.       call quitit(getcatstr(22,'Error, archive not found.'))
  411.    if listLZX|~exists('T:LZXDir.list'handle) then
  412.       call LZXlist
  413.    call open('tempfile','T:LZXDir.list'handle,'r')
  414.    do 9
  415.       call readln('tempfile')  /* waste the first 3 lines */
  416.       end
  417.  
  418.    compstr=upper(LZXsubdir)
  419.    complen=length(compstr)
  420.    nextline=readln('tempfile')
  421.  
  422.    do until eof('tempfile')
  423.       do while pos('%',nextline)=length(nextline)
  424.          nextline=readln('tempfile')
  425.       end
  426.       name=strip(substr(nextline,64,length(nextline)))
  427.       infoline=nextline
  428.       if nextline=='-------- -------- ----- --------- --------' then
  429.          leave
  430.       comment=''
  431.       nextline=readln('tempfile')
  432.  
  433.       if upper(left(name,complen))==compstr then do
  434.          name=substr(name,complen+1)
  435.          if name~==''&pos('"',name)=0 then do
  436.             if pos('/',name)>0 then do  /* it's a dir */
  437.                parse var name dirname '/'
  438.                olddir=0
  439.                i=ndirs+1
  440.                do while i>1&~olddir
  441.                   i=i-1
  442.                   olddir=upper(dirname)==upper(dirname.i)
  443.                   end
  444.                if olddir&~show then do
  445.                   call convertdate
  446.                   dirsize.i=dirsize.i+size
  447.                   if seconds>dirsecs.i then
  448.                      dirsecs.i=seconds
  449.                   end
  450.                if show&~olddir then do  /* a new dir */
  451.                   ndirs=ndirs+1
  452.                   dirname.ndirs=dirname
  453.                   lister add handle '"'dirname'" -1 1' now '----rwed'
  454.                   end
  455.                end
  456.             else  /* it's a file */
  457.                 if show then do
  458.                   call convertdate
  459.                   lister add handle '"'name'"' size '-1' seconds atts comment
  460.                   end
  461.             end
  462.          end
  463.       end
  464.    call close('tempfile')
  465.    if ~show then
  466.       do i=1 to ndirs
  467.          lister add handle '"'dirname.i'"' dirsize.i '1' dirsecs.i '----rwed'
  468.          lister select handle '"'dirname.i'"' on
  469.          end
  470.    lister refresh handle full
  471.    return
  472.  
  473.  
  474. checkLZXdir:
  475.  
  476.    arg checkhandle
  477.    lister query checkhandle path
  478.    winpath=result
  479.    test=upper(winpath)
  480.    cuthere=pos('.LZX/',test)
  481.    LZXdir=cuthere>0
  482.    if LZXdir then do
  483.       LZXfile=left(winpath,cuthere+3)
  484.       LZXsubdir=substr(winpath,cuthere+5)
  485.       end
  486.    return
  487.  
  488.  
  489. LZXextract:
  490.  
  491.    lister query handle numdirs
  492.    anydirs=result>0
  493.    mustmove=anydirs&s_LZXsubdir~==''
  494.    if mustmove then
  495.       destpath=winpath'LZXDir'handle'/'
  496.    else
  497.       destpath=winpath
  498.  
  499.    actionfile_1=""
  500.    call open('actionfile','T:actionfile'handle,'w')
  501.    do i=1 to entries
  502.       if type.i>0 then
  503.          wild='/#?'
  504.       else
  505.          wild=''
  506.       call writeln('actionfile','"'patch(s_LZXsubdir||name.i,1)||wild'"')
  507.       actionfile_1=actionfile_1||'"'patch(s_LZXsubdir||name.i,1)||wild'" '
  508.       end
  509.    call close('actionfile')
  510.  
  511.  
  512.    if anydirs then
  513.       LZXcmd='x'
  514.    else
  515.       LZXcmd='e'
  516.    lister set handle progress '-1' getcatstr(10,'Extracting from archive...')
  517.    address command 'LZX ' LZXcmd ' -m -a "'patch(s_LZXfile,0)'" "'destpath'" 'actionfile_1
  518.    problem=rc>0
  519.    if problem then
  520.       topline=getcatstr(11,'Error while extracting from archive.')
  521.    else
  522.       if notmove then do
  523.          do i=1 to entries
  524.             lister select handle '"'name.i'"' off
  525.             end
  526.          lister refresh handle
  527.          end
  528.  
  529.    if mustmove then do
  530.       address command 'Rename >NIL: "'winpath'LZXDir'handle'/'s_LZXsubdir'#?" "'winpath'" QUIET'
  531.       address command 'Delete >NIL: "'winpath'LZXDir'handle'" ALL QUIET'
  532.       end
  533.    address command 'Delete >NIL: T:actionfile'handle 'QUIET'
  534.    return
  535.  
  536.  
  537. LZXadd:
  538.  
  539.    mustcopy=upper(right(src,length(LZXsubdir)))~==upper(LZXsubdir)
  540.    if mustcopy then do  /* all files must be copied to T: before they can be added */
  541.       homedir='T:LZXDir'handle'/'
  542.       call createdirs
  543.       end
  544.    else
  545.       homedir=left(src,length(src)-length(LZXsubdir))
  546.    actionfile_1=""
  547.    call open('actionfile','T:actionfile'handle,'w')
  548.    call writeln('actionfile','"'patch(homedir,0)'"')
  549.    actionfile_1=actionfile_1||'"'patch(homedir,0)'" '
  550.  
  551.    if s_LZXdir then
  552.       call writeln('actionfile','#?')
  553.       actionfile_1=actionfile_1||'#? '
  554.    else do
  555.       do i=1 to entries
  556.          call writeln('actionfile','"'patch(LZXsubdir||name.i,0)'"')
  557.          actionfile_1=actionfile_1||'"'patch(LZXsubdir||name.i,0)'" '
  558.          if mustcopy then
  559.             address command 'Copy "'src||name.i'" "T:LZXDir'handle'/'LZXsubdir'"'
  560.          end
  561.       end
  562.    call close('actionfile')
  563.  
  564.    lister set desthandle progress '-1' getcatstr(12,'Adding to archive...')
  565.    address command 'LZX r -m -e -r "'patch(LZXfile,0)'" 'actionfile_1
  566.    problem=rc>0
  567.    if problem then
  568.       topline=getcatstr(13,'Error while adding to archive.')
  569.    else
  570.       if notmove then do
  571.          do i=1 to entries
  572.             lister select handle '"'name.i'"' off
  573.             end
  574.          lister refresh handle
  575.          end
  576.    address command 'Delete >NIL: T:actionfile'handle 'QUIET'
  577.    if mustcopy|s_LZXdir then
  578.       address command 'Delete >NIL: T:LZXDir'handle 'ALL QUIET'
  579.  
  580.    call swapactive
  581.    listLZX=1
  582.    call showLZXdir
  583.    call swapactive
  584.    return
  585.  
  586.  
  587. LZXlist:
  588.  
  589.    address command 'LZX >T:LZXDir.list'handle 'v "'LZXfile'"'
  590.    if rc>0 then
  591.       call quitit(getcatstr(2,'Error while listing archive.'))
  592.    return
  593.  
  594.  
  595. swapactive:
  596.  
  597.    swaphandle=handle
  598.    handle=desthandle
  599.    desthandle=swaphandle
  600.    return
  601.  
  602.  
  603. createdirs:
  604.  
  605.    parse arg subdir
  606.    dirstocreate='T:LZXDir'handle'/'LZXsubdir||subdir
  607.    here=0
  608.    mdstring=''
  609.    do until here=0
  610.       here=pos('/',dirstocreate,here+1)
  611.       if here>0 then
  612.          mdstring=mdstring '"'left(dirstocreate,here-1)'"'
  613.       end
  614.    address command 'MakeDir >NIL:' mdstring
  615.    return
  616.  
  617.  
  618. getall:
  619.  
  620.    lister query handle numseldirs
  621.    ndirs=result
  622.    lister query handle seldirs
  623.    do n=1 to ndirs
  624.       parse var result '"' name.n '"' result
  625.       type.n=1
  626.       end
  627.    lister query handle numselfiles
  628.    nfiles=result
  629.    lister query handle selfiles
  630.    do n=ndirs+1 to ndirs+nfiles
  631.       parse var result '"' name.n '"' result
  632.       type.n=-1
  633.       end
  634.    entries=ndirs+nfiles
  635.    return
  636.  
  637.  
  638. convertdate:  /* convert a file's datestamp to seconds past 01-Jan-78 */
  639.  
  640.    parse var infoline size .
  641.    infoline=substr(infoline,25,length(infoline))
  642.    parse var infoline day '-' month '-' year ' ' hours ':' minutes ':' seconds atts .
  643.    minus=day='00'
  644.    if minus then
  645.       day='01'
  646.    century=19+(year<78)
  647.    month=pos(month,'  JanFebMarAprMayJunJulAugSepOctNovDec')/3
  648.    month=right(month,2,'0')
  649.    if month='00' then
  650.       month='01'
  651.    seconds=seconds+minutes*60+hours*3600+(date('i',century||year||month||day,'s')-minus)*86400
  652.    return
  653.  
  654.  
  655. getfirstone:
  656.  
  657.    lister query handle firstsel
  658.    selentry=result
  659.    lister query handle entry selentry stem fileinfo.
  660.    selentry=fileinfo.name
  661.    filetype=fileinfo.type
  662.    return
  663.  
  664.  
  665. patch:  /* patch filenames containing strange characters */
  666.  
  667.    parse arg patched,apostrophe
  668.    verstr='*#?|%()[]~'
  669.    if apostrophe then
  670.       verstr=verstr"'"
  671.    pos=1
  672.    do until here=0
  673.       here=verify(substr(patched,pos),verstr,'m')
  674.       if here>0 then do
  675.          pos=pos+here+1
  676.          patched=insert("'",patched,pos-3)
  677.          end
  678.       end
  679.    if left(patched,1)='@' then
  680.       patched='*'patched
  681.    return patched
  682.  
  683.  
  684. getcatstr:
  685.  
  686.    parse arg msgno,msgstring,insert.1,insert.2
  687.    if catalog~=0 then
  688.       msgstring=getcatalogstr(catalog,msgno,msgstring)
  689.    i=0
  690.    do while pos('%s',msgstring)>0
  691.       parse var msgstring fore '%s' aft
  692.       i=i+1
  693.       msgstring=fore||insert.i||aft
  694.       end
  695.    return msgstring
  696.  
  697.  
  698. syntax:
  699.  
  700.    call quitit('Syntax Error' rc',' errortext(rc) 'in line' sigl'.')
  701.  
  702.  
  703. quitit:
  704.  
  705.    parse arg topline
  706.    lister clear handle progress
  707.    lister set handle busy off
  708.    if catalog~=0 then
  709.       call closecatalog(catalog)
  710.    if topline~=='' then
  711.       dopus request '"'topline'"' getcatstr(4,'OK')
  712.    exit
  713.